{ Классы двумерных динамических массивов

  Module is a part of project http://code.google.com/p/drivers-training-request
  Copyright (C) 2012 Leonid Vlasov leoniv@bk.ru

  This source is free software; you can redistribute it and/or modify it under
  the terms of the GNU General Public License as published by the Free
  Software Foundation; either version 2 of the License, or (at your option)
  any later version.

  This code is distributed in the hope that it will be useful, but WITHOUT ANY
  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  details.

  A copy of the GNU General Public License is available on the World Wide Web
  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  MA 02111-1307, USA.
}


unit stringdynarray;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type
  EDynArray=Class(Exception);
  
  TOnNotifyItem = Procedure(Sender: TObject; Col,Row: integer; Var Item: Pointer) of Object;
  TOnNotifyStringItem = Procedure(Sender: TObject; Col,Row: integer; ItemValue: String) of Object;
  TOnNotifyAddCol = Procedure(Sender: TObject; Index: integer; P:Pointer) of Object;
  TOnNotifyColRow = Procedure(Sender: TObject; Index: integer) of Object;
  TOnExchangeItem = procedure (Sender: TObject; Index, WithIndex: Integer) of Object;
  TOperationEvent = procedure (Sender: TObject; IsColumn:Boolean;sIndex, tIndex: Integer) of object;
  {TDynArray}
  TDynArray=Class
    FCols: TList;
    FOnDestroyItem: TOnNotifyItem;
    FOnNewItem: TonNotifyItem;
    function Getarr(Col, Row: Integer): Pointer;
    procedure Setarr(Col, Row: Integer; const AValue: Pointer);
    procedure ClearCol(L: TList; Col: Integer);
    procedure Aumentar_Rows(col,Rows: Integer; L: TList);
    procedure DestroyItem(Col,Row: Integer; P: Pointer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetLength(Cols,Rows: Integer);virtual;

    procedure DeleteColRow(IsColumn: Boolean; Index: Integer);Virtual;
    procedure MoveColRow(IsColumn:Boolean; FromIndex, ToIndex: Integer);
    procedure ExchangeColRow(IsColumn:Boolean; Index, WithIndex: Integer);
    procedure Clear;
    Property Arr[Col,Row: Integer]: Pointer read GetArr write SetArr; default;
    Property OnDestroyItem: TOnNotifyItem read FOnDestroyItem write FOnDestroyItem;
    Property OnNewItem: TOnNotifyItem read FOnNewItem write FOnNewItem;
  end;

  { TStrDynArray }
  TStrDynArray=Class
    FArray:TDynArray;
    FOnAddCol: TOnNotifyAddCol;
    FOnAddRow: TOnNotifyColRow;
    FOnDelCol: TOnNotifyColRow;
    FOnDelRow: TOnNotifyColRow;
    FOnSetValue: TOnNotifyStringItem;
    FOnMoveColRow: TOperationEvent;
    function GetColCount: Integer;
    function GetRowCount: Integer;
    function GetString(Col, Row: Integer): String;
    procedure SetColCount(AValue: Integer);
    procedure SetOnAddCol(AValue: TOnNotifyAddCol);
    procedure SetOnAddRow(AValue: TOnNotifyColRow);
    procedure SetOnDelCol(AValue: TOnNotifyColRow);
    procedure SetOnDelRow(AValue: TOnNotifyColRow);
    procedure SetOnSetValue(AValue: TOnNotifyStringItem);
    procedure SetRowCount(AValue: Integer);
    procedure SetString(Col, Row: Integer; AValue: String);
    procedure MoveColRow(IsColumn:Boolean; FromIndex, ToIndex: Integer;DontSendEvent:Boolean);
       procedure OnNewItem(Sender:TObject;Col,Row:Integer;var P:Pointer);
       procedure OnDestroyItem(Sender:TObject;Col,Row:Integer;var P:Pointer);
       procedure SetOnMoveColRow(AValue: TOperationEvent);
    public
     constructor Create;
     destructor Destroy;
     procedure SetLength(Cols,Rows: Integer);Virtual;
     procedure DeleteColRow(IsColumn: Boolean; Index: Integer);Virtual;
     procedure DelRow(Index:Integer);
     procedure DelCol(Index:Integer);Virtual;
     procedure AddRow();
     procedure AddCol();virtual;
     procedure InsertCol(Index:Integer);Virtual;
     procedure Clear;Virtual;
     property ColCount:Integer read GetColCount write SetColCount;
     property RowCount:Integer read GetRowCount write SetRowCount;
     property Cells[Col,Row:Integer]:String read GetString write SetString;
     property OnSetValue:TOnNotifyStringItem read FOnSetValue write SetOnSetValue;
     property OnAddRow:TOnNotifyColRow read FOnAddRow write SetOnAddRow ;
     property OnAddCol:TOnNotifyAddCol read FOnAddCol write SetOnAddCol;
     property OnDelRow:TOnNotifyColRow read FOnDelRow write SetOnDelRow;
     property OnDelCol:TOnNotifyColRow read FOnDelCol write SetOnDelCol;
     property OnMoveColRow:TOperationEvent read FOnMoveColRow write SetOnMoveColRow;
  end;

implementation
{ TStrDynArray }

function TStrDynArray.GetColCount: Integer;
begin
  Result:=FArray.FCols.Count;
end;

function TStrDynArray.GetRowCount: Integer;
begin
  if FArray.FCols.Count=0 then
     result:=0
  else
    result:=TList(FArray.FCols[0]).Count;
end;

function TStrDynArray.GetString(Col, Row: Integer): String;
begin
  if FArray.Arr[Col,Row]= nil then
     Result:=''
  else
     Result:=String(PChar(FArray.Arr[Col,Row]));
end;

procedure TStrDynArray.SetColCount(AValue: Integer);
begin
 SetLength(AValue,RowCount);
end;

procedure TStrDynArray.SetOnAddCol(AValue: TOnNotifyAddCol);
begin
  if FOnAddCol=AValue then Exit;
  FOnAddCol:=AValue;
end;

procedure TStrDynArray.SetOnAddRow(AValue: TOnNotifyColRow);
begin
  if FOnAddRow=AValue then Exit;
  FOnAddRow:=AValue;
end;


procedure TStrDynArray.SetOnDelCol(AValue: TOnNotifyColRow);
begin
  if FOnDelCol=AValue then Exit;
  FOnDelCol:=AValue;
end;

procedure TStrDynArray.SetOnDelRow(AValue: TOnNotifyColRow);
begin
  if FOnDelRow=AValue then Exit;
  FOnDelRow:=AValue;
end;

procedure TStrDynArray.SetOnSetValue(AValue: TOnNotifyStringItem);
begin
  if FOnSetValue=AValue then Exit;
  FOnSetValue:=AValue;
end;

procedure TStrDynArray.SetRowCount(AValue: Integer);
begin
  SetLength(ColCount,AValue);
end;

procedure TStrDynArray.SetString(Col, Row: Integer; AValue: String);
var
  Pstr:PChar;
begin
  Getmem(PStr,Length(AValue)+1);
  {TODO  -o: -c: : Реализовать метод TStrDynArray.SetString }
  FArray.Arr[Col,Row]:=strcopy(Pstr,PChar(AValue));
  if Assigned(FOnSetValue) then FOnSetValue(Self,Col,Row, String(PChar(Pstr)));
end;

destructor TStrDynArray.Destroy;
Var
  P:PChar;
  i: Integer;
  j: Integer;
begin
  FArray.Destroy;
  //for i:=0 to FCols.Count-1 do
  //  for j:=0 to TList(FCols[i]).Count-1 do
  //    begin
  //      P:= TList(FCols[i])[j];
  //      if P <> nil
  //      then
  //          Freemem(P);
  //    end;
  inherited Destroy;
end;

procedure TStrDynArray.SetLength(Cols, Rows: Integer);
var
  i: Integer;
begin
  //Если уменьшаем надо вызвать обработчик удаления
  if ColCount>Cols then
     for i:=Cols to ColCount-1 do
       If Assigned(FOnDelCol) then FOnDelCol(Self,i);
  if RowCount>Rows then
     for i:=Rows to RowCount-1 do
       If Assigned(FOnDelRow) then FOnDelRow(Self,i);
  //Увеличили размер  вызвать обработчик добавления
  if ColCount<Cols then
       for i:=ColCount to Cols-1 do
         {TODO  -o: -c: : Передавать описатель поля }
         If Assigned(FOnAddCol) then FOnAddCol(Self,i,nil);
  if RowCount<Rows then
      for i:=RowCount to Rows-1 do
         If Assigned(FOnAddRow) then FOnAddRow(Self,i);
  FArray.SetLength(Cols, Rows);
end;

procedure TStrDynArray.DelRow(Index: Integer);
begin
  DeleteColRow(False,Index);
end;

procedure TStrDynArray.DelCol(Index: Integer);
begin
  DeleteColRow(True,Index);
end;

procedure TStrDynArray.AddRow;
begin
  RowCount:=RowCount+1;
end;

procedure TStrDynArray.AddCol;
begin
 ColCount:=ColCount+1;
end;

procedure TStrDynArray.InsertCol(Index: Integer);
var
  Count:Integer;
begin
  if (Index>ColCount-1) or (Index<0) then Raise EDynArray.Create('Index out of range');
  AddCol();
  MoveColRow(true,ColCount-1,Index,False);
end;

procedure TStrDynArray.Clear;
begin
  FArray.Clear;
end;

procedure TStrDynArray.MoveColRow(IsColumn: Boolean; FromIndex,
  ToIndex: Integer;DontSendEvent:Boolean);
begin
  {TODO  -o: -c: : Реализовать метод TStrDynArray.MoveColRow }
  if Assigned(FOnMoveColRow) and Not DontSendEvent then FOnMoveColRow(Self,IsColumn,FromIndex,ToIndex);
  FArray.MoveColRow(IsColumn,FromIndex,ToIndex);
end;

procedure TStrDynArray.DeleteColRow(IsColumn: Boolean; Index: Integer);
var
  L:TList;
  i:integer;
begin
  if IsColumn then begin
    if (Index>ColCount-1)  or (Index<0) then Raise EDynArray.Create('Index out of range');
    if Assigned(FOnDelCol) then FOnDelCol(Self,Index);
    //L:=TList(FCols[Index]);
    //If L<>nil then begin
    //   for i:=0 to L.Count-1 do
    //     IF L[i]<> nil then
    //        Freemem(L[i]);
    //end;
  end else begin
    if (Index>RowCount-1)  or (Index<0) then Raise EDynArray.Create('Index out of range');
    if Assigned(FOnDelRow) then FOnDelRow(Self,Index);
  //  for i:=0 to FCols.Count-1 do
  //    begin
  //      if Tlist(FCols[i])[Index] <> nil then
  //         Freemem(Tlist(FCols[i])[Index]);
  //    end;
  //
  end;
  FArray.DeleteColRow(IsColumn, Index);
end;

procedure TStrDynArray.OnNewItem(Sender: TObject; Col, Row: Integer;
  var P: Pointer);
begin
  P:=Nil;
end;

procedure TStrDynArray.OnDestroyItem(Sender: TObject; Col,
  Row: Integer; Var P: Pointer);
begin
  if (P<>nil) then Freemem(P);
end;

procedure TStrDynArray.SetOnMoveColRow(AValue: TOperationEvent);
begin
  if FOnMoveColRow=AValue then Exit;
  FOnMoveColRow:=AValue;
end;

constructor TStrDynArray.Create;
begin
  FArray:=TDynArray.Create;
  FArray.FOnDestroyItem:=@OnDestroyItem;
  FArray.FOnNewItem:=@OnNewItem;
  inherited Create;
end;


{ TDynArray }

function TDynArray.Getarr(Col, Row: Integer): Pointer;
begin
  // Checar dimensiones
  Result := TList(FCols[Col])[Row];
end;

procedure TDynArray.Setarr(Col, Row: Integer; const AValue: Pointer);
begin
  // Checar dimensiones
  TList(FCols[Col])[Row] := AValue;
end;

procedure TDynArray.ClearCol(L: TList; Col: Integer);
var
   j: Integer;
begin
  if L<>nil then begin
    for j:=0 to L.Count-1 do DestroyItem(Col,J, L[J]);
    L.Clear;
  end;
end;

procedure TDynArray.Clear;
var
   i: Integer;
begin
 // {$Ifdef dbgMem}DebugLn('TDynArray.Clear');{$endif}
  for i:=0 to FCols.Count-1 do begin
    ClearCol(TList(FCols[i]), i);
    TList(FCols[i]).Free;
  end;
  FCols.Clear;
end;

constructor TDynArray.Create;
begin
  inherited Create;
  FCols := TList.Create;
end;

destructor TDynArray.Destroy;
begin
  //{$Ifdef dbgMem}DebugLn('TDynArray.Destroy FCols.Count=',dbgs(FCols.Count));{$endif}
  Clear;
  FCols.free;
  inherited Destroy;
end;

procedure TDynArray.Aumentar_Rows(col,rows: Integer; L: TList);
var
   i,j: Integer;
   P: Pointer;
begin
  //DebugLn('TDynArray.Aumentar_Rows: Col=',Col,' Rows=',Rows);
  i:=L.Count;
  j:=Rows-L.Count;
  while j>0 do begin
    P:=nil;
    if Assigned(OnNewItem) Then OnNewItem(Self, col, i, P);
    L.Add(P);
    dec(j);
    inc(i);
  end;
end;

procedure TDynArray.DestroyItem(Col, Row: Integer; P: Pointer);
begin
  if (P<>nil)And Assigned(OnDestroyItem) then OnDestroyItem(Self, Col, Row, P);
end;

procedure TDynArray.SetLength(Cols, Rows: Integer);
var
   i,j: integer;
   L: TList;
   //P: Pointer;
Begin
  //{$IfDef DbgMem}DebugLn('TDynArray.SetLength: Cols=',dbgs(Cols),' Rows=',dbgs(Rows));{$Endif}
  //
  // Ajustar columnas
  //
  if FCols.Count>Cols then begin
    // Hay mas columnas de las que debe.
    // Destruir las columnas innecesarias
    for i:=Cols to fCols.Count-1 do begin
      L:=TList(FCols[i]);
      ClearCol(L, i);
      L.Free;
      L:=nil;
    end;
  end;
  FCols.Count:=Cols;

  //
  // Ajustar Renglones
  //
  for i:=0 to fCols.Count-1 do begin
    L:=TList(FCols[i]);
    if L=nil then L:=TList.Create;
    if L.Count>Rows then begin
      for j:=Rows to L.Count-1 do DestroyItem(i,j,L[j]);
      L.Count:=Rows;
    end;
    Aumentar_Rows(i, Rows, L);
    FCols[i]:=L;
  end;
end;

procedure TDynArray.DeleteColRow(IsColumn: Boolean; Index: Integer);
var
  i: Integer;
  L: TList;
begin
  if IsColumn then begin
   // {$Ifdef dbgMem}DebugLn('TDynArray.DeleteColRow Col=',dbgs(Index));{$endif}
    L:=TList(FCols[Index]);
    If L<>nil then begin
      ClearCol(L, Index);
      FCols.Delete(Index);
      L.Free;
    end;
  end else begin
   // {$Ifdef dbgMem}DebugLn('TDynArray.DeleteColRow Row=',dbgs(Index));{$endif}
    for i:=0 to fCols.Count - 1 do begin
      L:=TList(fcols[i]);
      if L<>nil then begin
        DestroyItem(i, Index, L[Index]);
        L.Delete(Index);
      end;
    end;
  end;
end;

procedure TDynArray.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
var
  i: Integer;
begin
  If IsColumn then begin
    FCols.Move(FromIndex, ToIndex);
  end else begin
    for i:=0 to FCols.Count-1 do
      TList(Fcols[i]).Move(FromIndex,ToIndex);
  end;
end;

procedure TDynArray.ExchangeColRow(IsColumn: Boolean; Index, WithIndex: Integer);
var
  i: Integer;
begin
  if IsColumn then begin
    FCols.Exchange(Index, WithIndex);
  end else begin
    for i:=0 to FCols.Count-1 do
      TList(FCols[i]).Exchange(Index, WithIndex);
  end;
end;

end.
